

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Object Score Plot Prototype
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth score-plot-proto :isnew (dims homals-parent)
 (send self :add-slot 'len)
 (send self :add-slot 'active-var-scroll-list)
 (send self :add-slot 'passive-var-scroll-list)
 (send self :add-slot 'cat-scroll-list)
 (let* (
        (data (send homals-parent :data-matrix))
        (vl (send homals-parent :variable-labels))
        (pass-vars (reverse (set-difference (iseq (send homals-parent :m))
                                    (send homals-parent :active-homals-variables))))
        (plot (if pass-vars (call-next-method dims homals-parent :go-away nil)
                            (call-next-method dims homals-parent)))
      )
  (send plot :plot-name "Object Score Plot")
  (send plot :setup dims self)
  (send self :get-modless-variable
    (mapcar #'(lambda (x) (sort-data (remove-duplicates x :test 'equal)))
        (column-list data)))
  plot))



(defmeth score-plot-proto :make-point-labels ()
 (let ((plot (send self :plot))
       (ol (send (send self :homals-parent) :object-labels)))
   (send plot :point-label (iseq (send plot :num-points)) ol)))

(defmeth score-plot-proto :selected-points ()
 (let ((plot (send self :plot)))
  (send plot :point-selected (iseq (send plot :num-points)) t)))

(defmeth score-plot-proto :make-lines (&optional point-list)
)

(defmeth score-plot-proto :cleanup ()
 (let* ((homals-parent (send self :homals-parent))
        (m (send homals-parent :m))
        (av (send homals-parent :active-homals-variables)))
   (if (< (length av) m) (send self :reset-scroll))))


(defmeth score-plot-proto :make-points ()
 (let (
       (z (column-list (break-columns 
                 (send (send self :homals-parent) :z) (send self :dims))))
       (plot (send self :plot))
      )
  (send plot :add-points z)))

(defmeth score-plot-proto :reset-scroll ()
  (let ((len (send self :len))
        (cat-scroll (send self :cat-scroll-list)))
    (when len
      (send cat-scroll :selection nil))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Dialog For Score Plot Proto
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(defmeth score-plot-proto :get-modless-variable (cats)
  (let* (
         (homals-parent (send self :homals-parent))
         (vl (send homals-parent :variable-labels))
         (av (send homals-parent :active-homals-variables))
         (pv (reverse (set-difference (iseq (send homals-parent :m)) av)))
         (av-cats (select cats av))
         (pv-cats (select cats pv))
         (active-data (select (column-list (send homals-parent :data-matrix)) av))
         (passive-data (select (column-list (send homals-parent :data-matrix)) pv))
         (num-pts (send self :send-to-plot :num-points))
         (symbs (repeat (select (plot-symbol-symbols)
                                (list 8 4 1 2 10 11 7 0)) 5))
         (len (max (mapcar #'length cats)))
         (ask-pass-variable (if pv (send text-item-proto :new
                (format nil "Passive~%Variable:"))))
         (pass-var-scroll-list (if pv
             (send list-item-proto :new (select vl pv)
                  :action #'(lambda (x)
                    (let ((pass-cat (elt pv-cats
                                     (send pass-var-scroll-list :selection))))
                       (send self :send-to-plot :point-selected
                              (send self :send-to-plot :points-showing) nil)
                       (send self :reset-scroll)
                       (send active-var-scroll-list :selection nil)
                       (mapcar #'(lambda (y)
                               (send cat-scroll-list :set-text y ""))
                           (iseq len))
                       (mapcar #'(lambda (y z)
                           (send cat-scroll-list :set-text z
                                       (format nil "~a" y)))
                            pass-cat
                           (iseq (length pass-cat)))
                       (send ask-symbols :do-action))))))
         (ask-active-variable (send text-item-proto :new
                (format nil "Active~%Variable:")))

         (active-var-scroll-list (send list-item-proto :new (select vl av)
                  :action #'(lambda (x)
                    (let ((active-cat (elt av-cats
                                   (send active-var-scroll-list :selection))))
                       (send self :send-to-plot :point-selected
                              (send self :send-to-plot :points-showing) nil)
                       (send self :reset-scroll)
                       (if pv (send pass-var-scroll-list :selection nil))
                       (mapcar #'(lambda (y)
                               (send cat-scroll-list :set-text y ""))
                           (iseq len))
                       (mapcar #'(lambda (y z)
                           (send cat-scroll-list :set-text z
                                       (format nil "~a" y)))
                            active-cat
                           (iseq (length active-cat)))
                       (send ask-symbols :do-action)))))
         (tell-cats (send text-item-proto :new "Categories:"))
         (cat-scroll-list (send list-item-proto :new (repeat "" len)
            :action #'(lambda (x)
              (send self :send-to-plot :point-selected
                           (send self :send-to-plot :points-showing) nil)
              (if (> (length (elt (send cat-scroll-list :slot-value 'list-data)
                                    (send cat-scroll-list :selection))) 0)
                    (progn
                     (let* ((pass-sel (if pv
                                       (send pass-var-scroll-list :selection)))
                            (act-sel (send active-var-scroll-list :selection))
                            (in-cat-pts (if pass-sel
                                   (= (elt (elt pv-cats
                                        (send pass-var-scroll-list :selection))
                                        (send cat-scroll-list :selection))
                                      (elt passive-data
                                        (send pass-var-scroll-list :selection)))
                                   (= (elt (elt av-cats
                                       (send active-var-scroll-list :selection))
                                       (send cat-scroll-list :selection))
                                      (elt active-data
                                        (send active-var-scroll-list
                                          :selection)))))
                            (showing-pts (send self :send-to-plot
                                            :point-showing (iseq num-pts)))
                            (match (which (mapcar #'(lambda (y z) (and y z))
                                      (coerce in-cat-pts 'list) showing-pts))))
                    (if match
                     (send self :send-to-plot :point-selected match 't))))))
              :columns 2))
         (ask-symbols (send toggle-item-proto :new "Use Symbols"
                :action #'(lambda ()
               (if (send ask-symbols :value)
                   (let* ((pass-sel (if pv
                                       (send pass-var-scroll-list :selection)))
                          (act-sel (send active-var-scroll-list :selection))

                          (new-cats (if pass-sel
                                  (elt pv-cats
                                    (send pass-var-scroll-list :selection))
                                  (elt av-cats
                                    (send active-var-scroll-list :selection))))
                          (symb-data (if pass-sel
                                  (elt passive-data
                                     (send pass-var-scroll-list :selection))
                                  (elt active-data
                                   (send active-var-scroll-list :selection)))))
                      (mapcar #'(lambda (y w)
                          (let ((ysymb (which (= y symb-data))))
                            (send self :send-to-plot :point-symbol ysymb
                                          (repeat w (length ysymb)))))
                         new-cats
                         (select symbs (iseq (length new-cats)))))
                      (send self :send-to-plot :point-symbol
                         (iseq num-pts) (repeat 'disk num-pts)))
               (send self :send-to-plot :redraw))))

         (close (send button-item-proto :new "Close Plot"
                      :action #'(lambda () (send dialog :remove)
                                           (send self :send-to-plot :close))))
         (dialog (send dialog-proto :new
                 (list
                    (remove nil
                      (list ask-active-variable active-var-scroll-list
                            ask-pass-variable pass-var-scroll-list))
                      (list tell-cats cat-scroll-list)
                      (remove nil (list close
                                        (if (kind-of-p (send self :plot)
                                                 homals-2d-plot-proto)
                                             (list ask-symbols)))))
                                    :title "Score Plot Dialog"
                                    :go-away nil))
        )
  (send active-var-scroll-list :selection 0)
  (send self :active-var-scroll-list active-var-scroll-list)
  (send self :cat-scroll-list cat-scroll-list)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Individual Category Quantification Plot Prototype
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth category-plot-proto :isnew (dims homals-parent)
 (let* (
        (av (send homals-parent :active-homals-variables))
        (vl (select (send homals-parent :variable-labels) av))
        (ij (get-modal-variable vl))
        (plot (call-next-method dims homals-parent))
       )
 (send self :add-slot 'ij ij)
 (send plot :plot-name (format nil "Category Plot: Variable ~a" (elt vl ij))) 
 (send plot :setup dims self)))


(defmeth category-plot-proto :make-point-labels ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (ij (send self :ij))
        (av (send homals-parent :active-homals-variables))
        (ac (send homals-parent :active-categories))
        (k-j (elt (send homals-parent :k-j-list) ij))
        (labels (mapcar #'(lambda (x) (format nil "~a~a"
                  (elt (select (send homals-parent :variable-labels) av) ij) x))
                    (iseq 1 k-j)))
       )
  (send plot :point-label (iseq (send plot :num-points)) labels)))

(defmeth category-plot-proto :selected-points ()
 (let ((plot (send self :plot)))
  (send plot :point-selected (iseq (send plot :num-points)) t)))


(defmeth category-plot-proto :make-lines (&optional point-list)
 (let* (
        (homals-parent (send self :homals-parent))
        (y (send homals-parent :y))
        (plot (send self :plot))
        (dims (send self :dims))
        (p (length dims))
        (ij (send self :ij))
        (k-j-cumsum (cumsum (cons 0 (send homals-parent :k-j-list))))
        (i-inds (iseq (elt k-j-cumsum ij) (1- (elt k-j-cumsum (1+ ij)))))
        (yy (column-list (select y i-inds dims)))
        (point-list (if point-list point-list (iseq (length (first yy)))))
       )
    (mapcar #'(lambda (x) (send plot :add-lines
                (transpose (list x (repeat 0 p)))))
                (transpose (mapcar #'(lambda (x)
                            (select (coerce x 'list) point-list)) yy)))))


(defmeth category-plot-proto :make-points ()
 (let* (
        (homals-parent (send self :homals-parent))
        (y (send homals-parent :y))
        (plot (send self :plot))
        (dims (send self :dims))
        (ij (send self :ij))
        (k-j-cumsum (cumsum (cons 0 (send homals-parent :k-j-list))))
        (i-inds (iseq (elt k-j-cumsum ij) (1- (elt k-j-cumsum (1+ ij)))))
        (yy (column-list (select y i-inds dims)))
       )
   (send plot :add-points yy)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Combined Category Quantification Plot Prototype
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth combined-category-plot-proto :isnew (dims homals-parent)
 (let ((plot (call-next-method dims homals-parent)))
   (send plot :plot-name "Combined Category Quantification Plot")
   (send plot :setup dims self)))

(defmeth combined-category-plot-proto :make-point-labels ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (z (break-columns (send homals-parent :z) dims))
        (yy (send homals-parent :k-j-list))
        (catlabel (mapcar #'(lambda (x) (iseq 1 x)) yy))
        (av (send homals-parent :active-homals-variables))
        (vl (select (send homals-parent :variable-labels) av))
        (pt-labels (combine (mapcar #'(lambda (x y) (mapcar #'(lambda (z)
                    (format nil "~a~a" x z)) y)) vl catlabel)))
       )
   (send plot :point-label (iseq (send plot :num-points)) pt-labels)))

(defmeth combined-category-plot-proto :selected-points ()
 (let ((plot (send self :plot)))
  (send plot :point-selected (iseq (send plot :num-points)) t)))


(defmeth combined-category-plot-proto :make-lines (&optional point-list)
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (p (length dims))
        (k (sum (send homals-parent :k-j-list)))
        (point-list (if point-list (select point-list (which (< point-list k)))
                                   (iseq k)))
        (yvars (select (transpose (map-elements #'coerce (select (column-list
                         (send homals-parent :y)) dims) 'list)) point-list))
       )
   (mapcar #'(lambda (x) (send plot :add-lines
               (transpose (list x (repeat 0 p))))) yvars)))



(defmeth category-object-plot-proto :make-points ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (n (send homals-parent :n))
        (yvars (map-elements #'coerce
                   (select (column-list (send homals-parent :y)) dims) 'list))
        (z (break-columns (send homals-parent :z) dims))
        (ylen (length (first yvars)))
       )
 (send plot :add-points yvars)
 (send plot :add-points (column-list z))
 (send plot :point-symbol (iseq ylen (+ ylen n (- 1))) 'x)))



(defmeth combined-category-plot-proto :make-points ()
 (let* (
        (homals-parent (send self :homals-parent))
        (plot (send self :plot))
        (dims (send self :dims))
        (n (send homals-parent :n))
        (yvars (map-elements #'coerce
                   (select (column-list (send homals-parent :y)) dims) 'list))
        (ylen (length (first yvars)))
       )
 (send plot :add-points yvars)))


